home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / mosmllib / Time.sml < prev    next >
Encoding:
Text File  |  1997-08-18  |  4.9 KB  |  148 lines  |  [TEXT/R*ch]
  1. (* Time -- new basis 1995-02-25, 1995-05-12 *)
  2.  
  3. local 
  4.     prim_val getrealtime_ : unit -> {sec : int, usec : int} 
  5.                                 = 1 "sml_getrealtime";
  6.     prim_val exp : real -> real = 1 "sml_exp";
  7.     prim_val ln  : real -> real = 1 "sml_ln";
  8.  
  9.     fun negpow10 p = exp(ln 10.0 * real (~p));
  10.  
  11.     (* Translation to obtain a longer time horizon.  Must agree with
  12.        TIMEBASE in file runtime/mosml.c *)
  13.     val timebase = ~1073741824;        
  14. in
  15.     type time = {sec : int, usec : int}
  16.     (* Invariant: sec >= timebase and 0 <= usec < 1000000.
  17.        Represents the duration (sec-timebase)+usec/1000000 seconds; 
  18.        or the duration since UTC 00:00 on 1 Jan 1970).
  19.      *)
  20.  
  21.     exception Time
  22.  
  23.     val zeroTime = {sec = timebase, usec = 0};
  24.     fun now () = getrealtime_ ();
  25.  
  26.     fun fromSeconds s = 
  27.     if s < 0 then raise Time else {sec=s+timebase, usec=0};
  28.  
  29.     fun fromMilliseconds ms = 
  30.     if ms < 0 then raise Time else 
  31.         {sec=ms div 1000+timebase, usec=ms mod 1000 * 1000};
  32.  
  33.     fun fromMicroseconds us = 
  34.     if us < 0 then raise Time else 
  35.         {sec=us div 1000000+timebase, usec=us mod 1000000};
  36.  
  37.     fun toSeconds {sec, usec} = sec-timebase;
  38.  
  39.     fun toMilliseconds {sec, usec} = (sec-timebase) * 1000 + usec div 1000;
  40.  
  41.     fun toMicroseconds {sec, usec} = (sec-timebase) * 1000000 + usec;
  42.  
  43.     fun fromReal r =               
  44.     let 
  45.         val rf = if r < 0.0 then raise Time else floor (r + real timebase)
  46.     in
  47.         {sec = rf, usec = floor (1000000.0 * (r+real timebase-real rf))} 
  48.     end handle Overflow => raise Time;
  49.  
  50.     fun toReal {sec, usec} =
  51.     real sec - real timebase + real usec / 1000000.0;
  52.  
  53.     fun timeToUnits (t, p) = floor(toReal t * negpow10 p + 0.5);
  54.  
  55.     fun fmt p {sec, usec} =
  56.     let fun frac r = r - real (floor r) 
  57.         val rnd  = if p < 0 then 0.5 
  58.                else 0.5 * negpow10 p 
  59.         val usecr = real usec / 1000000.0 + rnd
  60.         prim_val int_to_string : int -> string = 1 "sml_string_of_int";
  61.         val ints = int_to_string (sec - timebase + floor usecr)
  62.         fun h v i = if i <= 0 then []
  63.             else Char.chr (floor v + Char.ord #"0") 
  64.                              :: h (10.0 * frac v) (i-1)
  65.     in 
  66.         if p > 0 then 
  67.         ints ^ "." ^ String.implode (h (10.0 * frac usecr) 
  68.                          (if p > 6 then 6 else p))
  69.         else ints
  70.     end;
  71.  
  72.     fun toString t = fmt 3 t;
  73.  
  74. fun scan getc source =
  75.     let fun skipWSget getc source = 
  76.         getc (StringCvt.dropl Char.isSpace getc source)
  77.     fun decval c = Char.ord c - 48;
  78.         fun pow10 0 = 1
  79.       | pow10 n = 10 * pow10 (n-1)
  80.     fun mktime intgv decs fracv =
  81.         let val usecs = (pow10 (7-decs) * fracv + 5) div 10
  82.         in
  83.         {sec = floor(intgv+real timebase+0.5) + usecs div 1000000, 
  84.          usec = usecs mod 1000000}
  85.         end
  86.     fun skipdigs src =
  87.         case getc src of 
  88.         NONE          => src
  89.           | SOME(c, rest) => if Char.isDigit c then skipdigs rest 
  90.                  else src
  91.     fun frac intgv decs fracv src =
  92.         if decs >= 7 then SOME(mktime intgv decs fracv, skipdigs src)
  93.         else case getc src of
  94.         NONE          => SOME(mktime intgv decs fracv, src)
  95.           | SOME(c, rest) => 
  96.             if Char.isDigit c then 
  97.             frac intgv (decs+1) (10 * fracv + decval c) rest
  98.             else 
  99.             SOME(mktime intgv decs fracv, src)
  100.     fun intg intgv src = 
  101.         case getc src of
  102.         NONE              => SOME(mktime intgv 6 0, src)
  103.           | SOME (#".", rest) => frac intgv 0 0 rest
  104.           | SOME (c, rest)    => 
  105.             if Char.isDigit c then 
  106.             intg (10.0 * intgv + real(decval c)) rest 
  107.             else SOME(mktime intgv 6 0, src)
  108.     in case skipWSget getc source of
  109.     NONE             => NONE
  110.       | SOME(#".", rest) => 
  111.             (case getc rest of
  112.              NONE          => NONE
  113.                | SOME(c, rest) => 
  114.                  if Char.isDigit c then frac 0.0 1 (decval c) rest
  115.                  else NONE)
  116.       | SOME(c, rest)    => 
  117.         if Char.isDigit c then intg (real (decval c)) rest else NONE
  118.     end;
  119.  
  120.     fun fromString s = StringCvt.scanString scan s;
  121.  
  122.     val op + = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
  123.     let val usecs = usec1 + usec2 in
  124.         {sec  = sec1 - timebase + sec2 + usecs div 1000000,
  125.          usec = usecs mod 1000000}
  126.     end 
  127.     and op - = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
  128.     let val usecs = usec1 - usec2 
  129.         val secs  = sec1 - sec2 + usecs div 1000000
  130.     in
  131.         if secs < 0 then raise Time 
  132.         else {sec = secs + timebase, usec = usecs mod 1000000}
  133.     end handle Overflow => raise Time;
  134.  
  135.     val op <  = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
  136.     (sec1 < sec2) orelse (sec1=sec2 andalso usec1 < usec2)
  137.     and op <= = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
  138.     (sec1 < sec2) orelse (sec1=sec2 andalso usec1 <= usec2)
  139.     and op >  = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
  140.     (sec1 > sec2) orelse (sec1=sec2 andalso usec1 > usec2)
  141.     and op >= = fn ({sec=sec1, usec=usec1} : time, {sec=sec2, usec=usec2}) =>
  142.     (sec1 > sec2) orelse (sec1=sec2 andalso usec1 >= usec2);
  143.  
  144.     fun compare (x, y: time) = 
  145.     if x<y then LESS else if x>y then GREATER else EQUAL;
  146.  
  147. end
  148.